home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / list.pas < prev    next >
Pascal/Delphi Source File  |  1985-03-15  |  4KB  |  161 lines
  1. PROGRAM LIST; {12/27/84}
  2.  
  3. { Compile with TURBO PASCAL.
  4.  
  5. LIST -  Program source code listing utility.
  6.  
  7. Will format and print standard ASCII files:
  8.   -Allows up to 20 files to be specified to be printed batch style.
  9.   -Paginates (standard 8 1/2 X 11 paper, 80-column printer).
  10.   -Correct pagination even if some lines exceed right margin and printer
  11.       "wraps" to next line.
  12.   -Allows you to specify a left margin (default is 5), so listing can
  13.       be inserted in loose-leaf binder.
  14.   -Prints header with file name and page number.
  15.   -Allows additional text in header, such as date, name, etc..
  16.  
  17. Usage:
  18.   Have printer ready, then type LIST <Enter> at DOS prompt and respond
  19.   to prompts in program.  Accepts drive designator for non-default drive,
  20.   but not DOS pathnames.  Begins printing immediately after optional
  21.   header text is entered.
  22.  
  23. Author:
  24.   Frank L. Eskridge
  25.   2895 Hill Park Court
  26.   Marietta, GA  30062
  27.   (404) 973-1714                                                         }
  28.  
  29. TYPE  namestring=STRING[12];
  30.  
  31. VAR
  32.    input_file            :TEXT;
  33.    filename              :ARRAY [1..20] OF NAMESTRING;
  34.    header                :STRING[50];
  35.    line                  :STRING[255];
  36.    header_length,
  37.    offset,i,c            :INTEGER;
  38.    ok                    :BOOLEAN;
  39.  
  40.  
  41. PROCEDURE SPACE(number:INTEGER);
  42. VAR x : INTEGER;
  43. BEGIN
  44.    FOR x := 1 TO number DO
  45.       WRITE(lst,' ');
  46. END;
  47.  
  48.  
  49. PROCEDURE LINE_FEED;
  50. BEGIN
  51.    WRITELN(lst,'');
  52. END;
  53.  
  54.  
  55. PROCEDURE CONVERT_TO_UPPER(VAR allcaps:namestring);
  56. VAR x       :INTEGER;
  57.     ch      :CHAR;
  58.     newword :NAMESTRING;
  59. BEGIN
  60.    newword := '';
  61.    FOR x := 1 TO LENGTH(allcaps) DO
  62.       BEGIN
  63.          ch := allcaps[x];
  64.          newword := newword + upcase(ch);
  65.       END;
  66.       allcaps := newword;
  67. END;
  68.  
  69.  
  70. PROCEDURE GET_FILENAMES;
  71. VAR ch :CHAR;
  72. BEGIN
  73.    i := 1;
  74.    REPEAT
  75.       WRITE('Name of file to list on printer (CR to end): ');
  76.       READLN(filename[i]);
  77.       CONVERT_TO_UPPER(filename[i]);
  78.       i := i+1;
  79.    UNTIL filename[i-1] = '';
  80. END;
  81.  
  82.  
  83. PROCEDURE GET_OFFSET;
  84. VAR cnum:   STRING[2];
  85.     code:   INTEGER;
  86. BEGIN
  87.    REPEAT
  88.       WRITE('Number of columns to offset left margin [5]: ');
  89.       READLN(cnum);
  90.       IF cnum = ''THEN cnum:='5';
  91.       VAL(cnum,offset,code);
  92.       IF (offset<0) OR (offset>50) THEN
  93.          WRITELN(#7+'Please enter a number between 0 and 50...');
  94.    UNTIL (offset>=0) AND (offset<51);
  95. END;
  96.  
  97.  
  98. PROCEDURE GET_HEADER;
  99. BEGIN
  100.    WRITE('Enter header or date, if any: ');
  101.    READLN(header);
  102. END;
  103.  
  104.  
  105. PROCEDURE OPEN(name:namestring);
  106. BEGIN
  107.    ASSIGN(input_file,filename[c]);
  108.    {$I-}RESET(input_file) {$I+};
  109.    ok := (IOResult=0);
  110.    IF NOT ok THEN WRITELN(#7+' ----> Invalid filename--ignoring.');
  111. END;
  112.  
  113.  
  114. PROCEDURE PRINT_FILE(name:namestring);
  115. VAR page,ln : INTEGER;
  116. BEGIN
  117.    page := 1;
  118.    header_length := LENGTH(filename[c])+LENGTH(header)+offset+2;
  119.    WHILE NOT EOF(input_file) DO
  120.       BEGIN
  121.          SPACE(offset);
  122.          WRITE(lst,filename[c]+'  '+header);
  123.          SPACE(65-header_length);
  124.          WRITE(lst,'Page');
  125.          WRITELN(lst,page:3);
  126.          LINE_FEED;LINE_FEED;
  127.          LN := 5;
  128.          WHILE (LN < 60) AND (NOT EOF(input_file)) DO
  129.             BEGIN
  130.                READLN(input_file,line);
  131.                SPACE(offset);
  132.                WRITELN(lst,line);
  133.                IF LENGTH(line) > 80-offset THEN LN := LN+1;
  134.                LN := LN+1;
  135.             END;
  136.          WRITE(lst,^L);
  137.          page := page + 1;
  138.       END;
  139. END;
  140.  
  141.  
  142. BEGIN {main program}
  143.    WRITELN('LIST --  Formats and prints up to 20 ASCII files.');
  144.    WRITELN('-------------------------------------------------');
  145.    GET_FILENAMES;
  146.    GET_OFFSET;
  147.    GET_HEADER;
  148.    WRITELN;
  149.    FOR c := 1 TO (i-2) DO
  150.       BEGIN
  151.          WRITE('Printing ---> '+filename[c]);
  152.          OPEN(filename[c]);
  153.          IF ok THEN
  154.             BEGIN
  155.                PRINT_FILE(filename[c]);
  156.                CLOSE(input_file);
  157.                WRITELN(' ----> Done');
  158.             END;
  159.       END;
  160. END.
  161.